home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl-5.003.tar.gz / perl-5.003.tar / perl-5.003 / pod / pod2man.PL < prev    next >
Perl Script  |  1996-03-25  |  27KB  |  1,084 lines
  1. #!/usr/local/bin/perl
  2.  
  3. use Config;
  4. use File::Basename qw(&basename &dirname);
  5.  
  6. # List explicitly here the variables you want Configure to
  7. # generate.  Metaconfig only looks for shell variables, so you
  8. # have to mention them as if they were shell variables, not
  9. # %Config entries.  Thus you write
  10. #  $startperl
  11. # to ensure Configure will look for $Config{startperl}.
  12.  
  13. # This forces PL files to create target in same directory as PL file.
  14. # This is so that make depend always knows where to find PL derivatives.
  15. chdir(dirname($0));
  16. ($file = basename($0)) =~ s/\.PL$//;
  17. $file =~ s/\.pl$//
  18.     if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
  19.  
  20. open OUT,">$file" or die "Can't create $file: $!";
  21.  
  22. print "Extracting $file (with variable substitutions)\n";
  23.  
  24. # In this section, perl variables will be expanded during extraction.
  25. # You can use $Config{...} to use Configure variables.
  26.  
  27. print OUT <<"!GROK!THIS!";
  28. $Config{'startperl'}
  29. !GROK!THIS!
  30.  
  31. # In the following, perl variables are not expanded during extraction.
  32.  
  33. print OUT <<'!NO!SUBS!';
  34. eval 'exec perl -S $0 "$@"'
  35.     if 0;
  36.  
  37. =head1 NAME
  38.  
  39. pod2man - translate embedded Perl pod directives into man pages
  40.  
  41. =head1 SYNOPSIS
  42.  
  43. B<pod2man>
  44. [ B<--section=>I<manext> ]
  45. [ B<--release=>I<relpatch> ]
  46. [ B<--center=>I<string> ]
  47. [ B<--date=>I<string> ]
  48. [ B<--fixed=>I<font> ]
  49. [ B<--official> ]
  50. I<inputfile>
  51.  
  52. =head1 DESCRIPTION
  53.  
  54. B<pod2man> converts its input file containing embedded pod directives (see
  55. L<perlpod>) into nroff source suitable for viewing with nroff(1) or
  56. troff(1) using the man(7) macro set.
  57.  
  58. Besides the obvious pod conversions, B<pod2man> also takes care of
  59. func(), func(n), and simple variable references like $foo or @bar so
  60. you don't have to use code escapes for them; complex expressions like
  61. C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
  62. little roffish things that it catches include translating the minus in
  63. something like foo-bar, making a long dash--like this--into a real em
  64. dash, fixing up "paired quotes", putting a little space after the
  65. parens in something like func(), making C++ and PI look right, making
  66. double underbars have a little tiny space between them, making ALLCAPS
  67. a teeny bit smaller in troff(1), and escaping backslashes so you don't
  68. have to.
  69.  
  70. =head1 OPTIONS
  71.  
  72. =over 8
  73.  
  74. =item center
  75.  
  76. Set the centered header to a specific string.  The default is
  77. "User Contributed Perl Documentation", unless the C<--official> flag is
  78. given, in which case the default is "Perl Programmers Reference Guide".
  79.  
  80. =item date
  81.  
  82. Set the left-hand footer string to this value.  By default,
  83. the modification date of the input file will be used.
  84.  
  85. =item fixed
  86.  
  87. The fixed font to use for code refs.  Defaults to CW.
  88.  
  89. =item official
  90.  
  91. Set the default header to indicate that this page is of
  92. the standard release in case C<--center> is not given.
  93.  
  94. =item release
  95.  
  96. Set the centered footer.  By default, this is the current
  97. perl release.
  98.  
  99. =item section
  100.  
  101. Set the section for the C<.TH> macro.  The standard conventions on
  102. sections are to use 1 for user commands,  2 for system calls, 3 for
  103. functions, 4 for devices, 5 for file formats, 6 for games, 7 for
  104. miscellaneous information, and 8 for administrator commands.  This works
  105. best if you put your Perl man pages in a separate tree, like
  106. F</usr/local/perl/man/>.  By default, section 1 will be used
  107. unless the file ends in F<.pm> in which case section 3 will be selected.
  108.  
  109. =back
  110.  
  111. =head1 Anatomy of a Proper Man Page
  112.  
  113. For those not sure of the proper layout of a man page, here's
  114. an example of the skeleton of a proper man page.  Head of the
  115. major headers should be setout as a C<=head1> directive, and
  116. are historically written in the rather startling ALL UPPER CASE
  117. format, although this is not mandatory.
  118. Minor headers may be included using C<=head2>, and are
  119. typically in mixed case.
  120.  
  121. =over 10
  122.  
  123. =item NAME
  124.  
  125. Mandatory section; should be a comma-separated list of programs or
  126. functions documented by this podpage, such as:
  127.  
  128.     foo, bar - programs to do something
  129.  
  130. =item SYNOPSIS
  131.  
  132. A short usage summary for programs and functions, which
  133. may someday be deemed mandatory.
  134.  
  135. =item DESCRIPTION
  136.  
  137. Long drawn out discussion of the program.  It's a good idea to break this
  138. up into subsections using the C<=head2> directives, like
  139.  
  140.     =head2 A Sample Subection
  141.  
  142.     =head2 Yet Another Sample Subection
  143.  
  144. =item OPTIONS
  145.  
  146. Some people make this separate from the description.
  147.  
  148. =item RETURN VALUE
  149.  
  150. What the program or function returns if successful.
  151.  
  152. =item ERRORS
  153.  
  154. Exceptions, return codes, exit stati, and errno settings.
  155.  
  156. =item EXAMPLES
  157.  
  158. Give some example uses of the program.
  159.  
  160. =item ENVIRONMENT
  161.  
  162. Envariables this program might care about.
  163.  
  164. =item FILES
  165.  
  166. All files used by the program.  You should probably use the FE<lt>E<gt>
  167. for these.
  168.  
  169. =item SEE ALSO
  170.  
  171. Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
  172.  
  173. =item NOTES
  174.  
  175. Miscellaneous commentary.
  176.  
  177. =item CAVEATS
  178.  
  179. Things to take special care with; sometimes called WARNINGS.
  180.  
  181. =item DIAGNOSTICS
  182.  
  183. All possible messages the program can print out--and
  184. what they mean.
  185.  
  186. =item BUGS
  187.  
  188. Things that are broken or just don't work quite right.
  189.  
  190. =item RESTRICTIONS
  191.  
  192. Bugs you don't plan to fix :-)
  193.  
  194. =item AUTHOR
  195.  
  196. Who wrote it (or AUTHORS if multiple).
  197.  
  198. =item HISTORY
  199.  
  200. Programs derived from other sources sometimes have this, or
  201. you might keep a modification long here.
  202.  
  203. =back
  204.  
  205. =head1 EXAMPLES
  206.  
  207.     pod2man program > program.1
  208.     pod2man some_module.pm > /usr/perl/man/man3/some_module.3
  209.     pod2man --section=7 note.pod > note.7
  210.  
  211. =head1 DIAGNOSTICS
  212.  
  213. The following diagnostics are generated by B<pod2man>.  Items
  214. marked "(W)" are non-fatal, whereas the "(F)" errors will cause
  215. B<pod2man> to immediately exit with a non-zero status.
  216.  
  217. =over 4
  218.  
  219. =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
  220.  
  221. (W) If you start include an option, you should set it off
  222. as bold, italic, or code.
  223.  
  224. =item can't open %s: %s
  225.  
  226. (F) The input file wasn't available for the given reason.
  227.  
  228. =item high bit char in input stream
  229.  
  230. (W) You can't use high-bit characters in the input stream,
  231. because the translator uses them for its own nefarious purposes.
  232. Use an HTML entity in angle brackets instead.
  233.  
  234. =item Improper man page - no dash in NAME header in paragraph %d of %s
  235.  
  236. (W) The NAME header did not have an isolated dash in it.  This is
  237. considered important.
  238.  
  239. =item Invalid man page - no NAME line in %s
  240.  
  241. (F) You did not include a NAME header, which is essential.
  242.  
  243. =item roff font should be 1 or 2 chars, not `%s'  (F)
  244.  
  245. (F) The font specified with the C<--fixed> option was not
  246. a one- or two-digit roff font.
  247.  
  248. =item %s is missing required section: %s
  249.  
  250. (W) Required sections include NAME, DESCRIPTION, and if you're
  251. using a section starting with a 3, also a SYNOPSIS.  Actually,
  252. not having a NAME is a fatal.
  253.  
  254. =item Unknown escape: %s in %s
  255.  
  256. (W) An unknown HTML entity (probably for an 8-bit character) was given via
  257. a C<E<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
  258. entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
  259. Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
  260. Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
  261. icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
  262. ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
  263. THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
  264. Yacute, yacute, and yuml.
  265.  
  266. =item Unmatched =back
  267.  
  268. (W) You have a C<=back> without a corresponding C<=over>.
  269.  
  270. =item Unrecognized pod directive: %s
  271.  
  272. (W) You specified a pod directive that isn't in the known list of
  273. C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
  274.  
  275.  
  276. =back
  277.  
  278. =head1 NOTES
  279.  
  280. If you would like to print out a lot of man page continuously, you
  281. probably want to set the C and D registers to set contiguous page
  282. numbering and even/odd paging, at least one some versions of man(7).
  283. Settting the F register will get you some additional experimental
  284. indexing:
  285.  
  286.     troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
  287.  
  288. The indexing merely outputs messages via C<.tm> for each
  289. major page, section, subsection, item, and any C<XE<lt>E<gt>>
  290. directives.
  291.  
  292.  
  293. =head1 RESTRICTIONS
  294.  
  295. You shouldn't use 8-bit characters in the input stream, as these
  296. will be used by the translator.
  297.  
  298. =head1 BUGS
  299.  
  300. The =over and =back directives don't really work right.  They
  301. take absolute positions instead of offsets, don't nest well, and
  302. making people count is suboptimal in any event.
  303.  
  304. =head1 AUTHORS
  305.  
  306. Original prototype by Larry Wall, but so massively hacked over by
  307. Tom Christiansen such that Larry probably doesn't recognize it anymore.
  308.  
  309. =cut
  310.  
  311. $/ = "";
  312. $cutting = 1;
  313.  
  314. ($version,$patch) = `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3}(?: +)(?:\S+)?)(?:.*patchlevel (\d\S*))?/s;
  315. $DEF_RELEASE  = "perl $version";
  316. $DEF_RELEASE .= ", patch $patch" if $patch;
  317.  
  318.  
  319. sub makedate {
  320.     my $secs = shift;
  321.     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
  322.     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
  323.     return "$mday/$mname/$year";
  324. }
  325.  
  326. use Getopt::Long;
  327.  
  328. $DEF_SECTION = 1;
  329. $DEF_CENTER = "User Contributed Perl Documentation";
  330. $STD_CENTER = "Perl Programmers Reference Guide";
  331. $DEF_FIXED = 'CW';
  332.  
  333. sub usage {
  334.     warn "$0: @_\n" if @_;
  335.     die <<EOF;
  336. usage: $0 [options] podpage
  337. Options are:
  338.     --section=manext      (default "$DEF_SECTION")
  339.     --release=relpatch    (default "$DEF_RELEASE")
  340.     --center=string       (default "$DEF_CENTER")
  341.     --date=string         (default "$DEF_DATE")
  342.     --fixed=font          (default "$DEF_FIXED")
  343.     --official          (default NOT)
  344. EOF
  345. }
  346.  
  347. $uok = GetOptions( qw(
  348.     section=s
  349.     release=s
  350.     center=s
  351.     date=s
  352.     fixed=s
  353.     official
  354.     help));
  355.  
  356. $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
  357.  
  358. usage("Usage error!") unless $uok;
  359. usage() if $opt_help;
  360. usage("Need one and only one podpage argument") unless @ARGV == 1;
  361.  
  362. $section = $opt_section || ($ARGV[0] =~ /\.pm$/ ? 3 : $DEF_SECTION);
  363. $RP = $opt_release || $DEF_RELEASE;
  364. $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
  365.  
  366. $CFont = $opt_fixed || $DEF_FIXED;
  367.  
  368. if (length($CFont) == 2) {
  369.     $CFont_embed = "\\f($CFont";
  370. }
  371. elsif (length($CFont) == 1) {
  372.     $CFont_embed = "\\f$CFont";
  373. }
  374. else {
  375.     die "roff font should be 1 or 2 chars, not `$CFont_embed'";
  376. }
  377.  
  378. $section = $opt_section || $DEF_SECTION;
  379. $date = $opt_date || $DEF_DATE;
  380.  
  381. for (qw{NAME DESCRIPTION}) {
  382. # for (qw{NAME DESCRIPTION AUTHOR}) {
  383.     $wanna_see{$_}++;
  384. }
  385. $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
  386.  
  387.  
  388. $name = @ARGV ? $ARGV[0] : "<STDIN>";
  389. $Filename = $name;
  390. $name = uc($name) if $section =~ /^1/;
  391. $name =~ s/\.[^.]*$//;
  392.  
  393. if ($name ne 'something') {
  394.     FCHECK: {
  395.     open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
  396.     while (<F>) {
  397.         next unless /^=\b/;
  398.         if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
  399.         $_ = <F>;
  400.         unless (/\s*-+\s+/) {
  401.             $oops++;
  402.             warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
  403.         }
  404.         %namedesc = split /\s+-\s+/;
  405.         last FCHECK;
  406.         }
  407.         next if /^=cut\b/;    # DB_File and Net::Ping have =cut before NAME
  408.         die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n";
  409.     }
  410.     die "$0: Invalid man page - no documentation in $ARGV[0]\n";
  411.     }
  412.     close F;
  413. }
  414.  
  415. print <<"END";
  416. .rn '' }`
  417. ''' \$RCSfile\$\$Revision\$\$Date\$
  418. '''
  419. ''' \$Log\$
  420. '''
  421. .de Sh
  422. .br
  423. .if t .Sp
  424. .ne 5
  425. .PP
  426. \\fB\\\\\$1\\fR
  427. .PP
  428. ..
  429. .de Sp
  430. .if t .sp .5v
  431. .if n .sp
  432. ..
  433. .de Ip
  434. .br
  435. .ie \\\\n(.\$>=3 .ne \\\\\$3
  436. .el .ne 3
  437. .IP "\\\\\$1" \\\\\$2
  438. ..
  439. .de Vb
  440. .ft $CFont
  441. .nf
  442. .ne \\\\\$1
  443. ..
  444. .de Ve
  445. .ft R
  446.  
  447. .fi
  448. ..
  449. '''
  450. '''
  451. '''     Set up \\*(-- to give an unbreakable dash;
  452. '''     string Tr holds user defined translation string.
  453. '''     Bell System Logo is used as a dummy character.
  454. '''
  455. .tr \\(*W-|\\(bv\\*(Tr
  456. .ie n \\{\\
  457. .ds -- \\(*W-
  458. .ds PI pi
  459. .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
  460. .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
  461. .ds L" ""
  462. .ds R" ""
  463. .ds L' '
  464. .ds R' '
  465. 'br\\}
  466. .el\\{\\
  467. .ds -- \\(em\\|
  468. .tr \\*(Tr
  469. .ds L" ``
  470. .ds R" ''
  471. .ds L' `
  472. .ds R' '
  473. .ds PI \\(*p
  474. 'br\\}
  475. END
  476.  
  477. print <<'END';
  478. .\"    If the F register is turned on, we'll generate
  479. .\"    index entries out stderr for the following things:
  480. .\"        TH    Title 
  481. .\"        SH    Header
  482. .\"        Sh    Subsection 
  483. .\"        Ip    Item
  484. .\"        X<>    Xref  (embedded
  485. .\"    Of course, you have to process the output yourself
  486. .\"    in some meaninful fashion.
  487. .if \nF \{
  488. .de IX
  489. .tm Index:\\$1\t\\n%\t"\\$2"
  490. ..
  491. .nr % 0
  492. .rr F
  493. .\}
  494. END
  495.  
  496. print <<"END";
  497. .TH $name $section "$RP" "$date" "$center"
  498. .IX Title "$name $section"
  499. .UC
  500. END
  501.  
  502. while (($name, $desc) = each %namedesc) {
  503.     for ($name, $desc) { s/^\s+//; s/\s+$//; }
  504.     print qq(.IX Name "$name - $desc"\n);
  505. }
  506.  
  507. print <<'END';
  508. .if n .hy 0
  509. .if n .na
  510. .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
  511. .de CQ          \" put $1 in typewriter font
  512. END
  513. print ".ft $CFont\n";
  514. print <<'END';
  515. 'if n "\c
  516. 'if t \\&\\$1\c
  517. 'if n \\&\\$1\c
  518. 'if n \&"
  519. \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
  520. '.ft R
  521. ..
  522. .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  523. .    \" AM - accent mark definitions
  524. .bd B 3
  525. .    \" fudge factors for nroff and troff
  526. .if n \{\
  527. .    ds #H 0
  528. .    ds #V .8m
  529. .    ds #F .3m
  530. .    ds #[ \f1
  531. .    ds #] \fP
  532. .\}
  533. .if t \{\
  534. .    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
  535. .    ds #V .6m
  536. .    ds #F 0
  537. .    ds #[ \&
  538. .    ds #] \&
  539. .\}
  540. .    \" simple accents for nroff and troff
  541. .if n \{\
  542. .    ds ' \&
  543. .    ds ` \&
  544. .    ds ^ \&
  545. .    ds , \&
  546. .    ds ~ ~
  547. .    ds ? ?
  548. .    ds ! !
  549. .    ds /
  550. .    ds q
  551. .\}
  552. .if t \{\
  553. .    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
  554. .    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
  555. .    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
  556. .    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
  557. .    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
  558. .    ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
  559. .    ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
  560. .    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
  561. .    ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
  562. .\}
  563. .    \" troff and (daisy-wheel) nroff accents
  564. .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
  565. .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
  566. .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
  567. .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
  568. .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
  569. .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
  570. .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
  571. .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
  572. .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
  573. .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
  574. .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
  575. .ds ae a\h'-(\w'a'u*4/10)'e
  576. .ds Ae A\h'-(\w'A'u*4/10)'E
  577. .ds oe o\h'-(\w'o'u*4/10)'e
  578. .ds Oe O\h'-(\w'O'u*4/10)'E
  579. .    \" corrections for vroff
  580. .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
  581. .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
  582. .    \" for low resolution devices (crt and lpr)
  583. .if \n(.H>23 .if \n(.V>19 \
  584. \{\
  585. .    ds : e
  586. .    ds 8 ss
  587. .    ds v \h'-1'\o'\(aa\(ga'
  588. .    ds _ \h'-1'^
  589. .    ds . \h'-1'.
  590. .    ds 3 3
  591. .    ds o a
  592. .    ds d- d\h'-1'\(ga
  593. .    ds D- D\h'-1'\(hy
  594. .    ds th \o'bp'
  595. .    ds Th \o'LP'
  596. .    ds ae ae
  597. .    ds Ae AE
  598. .    ds oe oe
  599. .    ds Oe OE
  600. .\}
  601. .rm #[ #] #H #V #F C
  602. END
  603.  
  604. $indent = 0;
  605.  
  606. while (<>) {
  607.     if ($cutting) {
  608.     next unless /^=/;
  609.     $cutting = 0;
  610.     }
  611.     chomp;
  612.  
  613.     # Translate verbatim paragraph
  614.  
  615.     if (/^\s/) {
  616.     @lines = split(/\n/);
  617.     for (@lines) {
  618.         1 while s
  619.         {^( [^\t]* ) \t ( \t* ) }
  620.         { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
  621.         s/\\/\\e/g;
  622.         s/\A/\\&/s;
  623.     }
  624.     $lines = @lines;
  625.     makespace() unless $verbatim++;
  626.     print ".Vb $lines\n";
  627.     print join("\n", @lines), "\n";
  628.     print ".Ve\n";
  629.     $needspace = 0;
  630.     next;
  631.     }
  632.  
  633.     $verbatim = 0;
  634.  
  635.     # check for things that'll hosed our noremap scheme; affects $_
  636.     init_noremap();
  637.  
  638.     if (!/^=item/) {
  639.  
  640.     # trofficate backslashes; must do it before what happens below
  641.     s/\\/noremap('\\e')/ge;
  642.  
  643.     # first hide the escapes in case we need to
  644.     # intuit something and get it wrong due to fmting
  645.  
  646.     s/([A-Z]<[^<>]*>)/noremap($1)/ge;
  647.  
  648.     # func() is a reference to a perl function
  649.     s{
  650.         \b
  651.         (
  652.         [:\w]+ \(\)
  653.         )
  654.     } {I<$1>}gx;
  655.  
  656.     # func(n) is a reference to a man page
  657.     s{
  658.         (\w+)
  659.         (
  660.         \(
  661.             [^\s,\051]+
  662.         \)
  663.         )
  664.     } {I<$1>\\|$2}gx;
  665.  
  666.     # convert simple variable references
  667.     s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
  668.  
  669.     if (m{ (
  670.             [\-\w]+
  671.             \(
  672.             [^\051]*?
  673.             [\@\$,]
  674.             [^\051]*?
  675.             \)
  676.         )
  677.         }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
  678.     {
  679.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
  680.         $oops++;
  681.     }
  682.  
  683.     while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
  684.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
  685.         $oops++;
  686.     }
  687.  
  688.     # put it back so we get the <> processed again;
  689.     clear_noremap(0); # 0 means leave the E's
  690.  
  691.     } else {
  692.     # trofficate backslashes
  693.     s/\\/noremap('\\e')/ge;
  694.  
  695.     }
  696.  
  697.     # need to hide E<> first; they're processed in clear_noremap
  698.     s/(E<[^<>]+>)/noremap($1)/ge;
  699.  
  700.  
  701.     $maxnest = 10;
  702.     while ($maxnest-- && /[A-Z]</) {
  703.  
  704.     # can't do C font here
  705.     s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
  706.  
  707.     # files and filelike refs in italics
  708.     s/F<([^<>]*)>/I<$1>/g;
  709.  
  710.     # no break -- usually we want C<> for this
  711.     s/S<([^<>]*)>/nobreak($1)/eg;
  712.  
  713.     # LREF: a manpage(3f)
  714.     s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
  715.  
  716.     # LREF: an =item on another manpage
  717.     s{
  718.         L<
  719.         ([^/]+)
  720.         /
  721.         (
  722.             [:\w]+
  723.             (\(\))?
  724.         )
  725.         >
  726.     } {the C<$2> entry in the I<$1> manpage}gx;
  727.  
  728.     # LREF: an =item on this manpage
  729.     s{
  730.        ((?:
  731.         L<
  732.         /
  733.         (
  734.             [:\w]+
  735.             (\(\))?
  736.         )
  737.         >
  738.         (,?\s+(and\s+)?)?
  739.       )+)
  740.     } { internal_lrefs($1) }gex;
  741.  
  742.     # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  743.     # the "func" can disambiguate
  744.     s{
  745.         L<
  746.         (?:
  747.             ([a-zA-Z]\S+?) /
  748.         )?
  749.         "?(.*?)"?
  750.         >
  751.     }{
  752.         do {
  753.         $1     # if no $1, assume it means on this page.
  754.             ?  "the section on I<$2> in the I<$1> manpage"
  755.             :  "the section on I<$2>"
  756.         }
  757.     }gex;
  758.  
  759.     s/Z<>/\\&/g;
  760.  
  761.     # comes last because not subject to reprocessing
  762.     s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
  763.     }
  764.  
  765.     if (s/^=//) {
  766.     $needspace = 0;        # Assume this.
  767.  
  768.     s/\n/ /g;
  769.  
  770.     ($Cmd, $_) = split(' ', $_, 2);
  771.  
  772.     if (defined $_) {
  773.         &escapes;
  774.         s/"/""/g;
  775.     }
  776.  
  777.     clear_noremap(1);
  778.  
  779.     if ($Cmd eq 'cut') {
  780.         $cutting = 1;
  781.     }
  782.     elsif ($Cmd eq 'head1') {
  783.         s/\s+$//;
  784.         delete $wanna_see{$_} if exists $wanna_see{$_};
  785.         print qq{.SH "$_"\n};
  786.         print qq{.IX Header "$_"\n};
  787.     }
  788.     elsif ($Cmd eq 'head2') {
  789.         print qq{.Sh "$_"\n};
  790.         print qq{.IX Subsection "$_"\n};
  791.     }
  792.     elsif ($Cmd eq 'over') {
  793.         push(@indent,$indent);
  794.         $indent += ($_ + 0) || 5;
  795.     }
  796.     elsif ($Cmd eq 'back') {
  797.         $indent = pop(@indent);
  798.         warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
  799.         $needspace = 1;
  800.     }
  801.     elsif ($Cmd eq 'item') {
  802.         s/^\*( |$)/\\(bu$1/g;
  803.         print STDOUT qq{.Ip "$_" $indent\n};
  804.         print qq{.IX Item "$_"\n};
  805.     }
  806.     elsif ($Cmd eq 'pod') {
  807.         # this is just a comment
  808.     } 
  809.     else {
  810.         warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
  811.     }
  812.     }
  813.     else {
  814.     if ($needspace) {
  815.         &makespace;
  816.     }
  817.     &escapes;
  818.     clear_noremap(1);
  819.     print $_, "\n";
  820.     $needspace = 1;
  821.     }
  822. }
  823.  
  824. print <<"END";
  825.  
  826. .rn }` ''
  827. END
  828.  
  829. if (%wanna_see) {
  830.     @missing = keys %wanna_see;
  831.     warn "$0: $Filename is missing required section"
  832.     .  (@missing > 1 && "s")
  833.     .  ": @missing\n";
  834.     $oops++;
  835. }
  836.  
  837. exit;
  838. #exit ($oops != 0);
  839.  
  840. #########################################################################
  841.  
  842. sub nobreak {
  843.     my $string = shift;
  844.     $string =~ s/ /\\ /g;
  845.     $string;
  846. }
  847.  
  848. sub escapes {
  849.  
  850.     s/X<(.*?)>/mkindex($1)/ge;
  851.  
  852.     # translate the minus in foo-bar into foo\-bar for roff
  853.     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
  854.  
  855.     # make -- into the string version \*(-- (defined above)
  856.     s/\b--\b/\\*(--/g;
  857.     s/"--([^"])/"\\*(--$1/g;  # should be a better way
  858.     s/([^"])--"/$1\\*(--"/g;
  859.  
  860.     # fix up quotes; this is somewhat tricky
  861.     if (!/""/) {
  862.     s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
  863.     s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
  864.     }
  865.  
  866.     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
  867.     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
  868.  
  869.  
  870.     # make sure that func() keeps a bit a space tween the parens
  871.     ### s/\b\(\)/\\|()/g;
  872.     ### s/\b\(\)/(\\|)/g;
  873.  
  874.     # make C++ into \*C+, which is a squinched version (defined above)
  875.     s/\bC\+\+/\\*(C+/g;
  876.  
  877.     # make double underbars have a little tiny space between them
  878.     s/__/_\\|_/g;
  879.  
  880.     # PI goes to \*(PI (defined above)
  881.     s/\bPI\b/noremap('\\*(PI')/ge;
  882.  
  883.     # make all caps a teeny bit smaller, but don't muck with embedded code literals
  884.     my $hidCFont = font('C');
  885.     if ($Cmd !~ /^head1/) { # SH already makes smaller
  886.     # /g isn't enough; 1 while or we'll be off
  887.  
  888. #    1 while s{
  889. #        (?!$hidCFont)(..|^.|^)
  890. #        \b
  891. #        (
  892. #        [A-Z][\/A-Z+:\-\d_$.]+
  893. #        )
  894. #        (s?)         
  895. #        \b
  896. #    } {$1\\s-1$2\\s0}gmox;
  897.  
  898.     1 while s{
  899.         (?!$hidCFont)(..|^.|^)
  900.         (
  901.         \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
  902.         )
  903.     } {
  904.         $1 . noremap( '\\s-1' .  $2 . '\\s0' )
  905.     }egmox;
  906.  
  907.     }
  908. }
  909.  
  910. # make troff just be normal, but make small nroff get quoted
  911. # decided to just put the quotes in the text; sigh;
  912. sub ccvt {
  913.      local($_,$prev) = @_;
  914.      if ( /^\W+$/ && !/^\$./ ) {
  915.      ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
  916.      # what about $" ?
  917.      } else {
  918.      noremap(qq{${CFont_embed}$_\\fR});
  919.      }
  920.     noremap(qq{.CQ "$_" \n\\&});
  921. }
  922.  
  923. sub makespace {
  924.     if ($indent) {
  925.     print ".Sp\n";
  926.     }
  927.     else {
  928.     print ".PP\n";
  929.     }
  930. }
  931.  
  932. sub mkindex {
  933.     my ($entry) = @_;
  934.     my @entries = split m:\s*/\s*:, $entry;
  935.     print ".IX Xref ";
  936.     for $entry (@entries) {
  937.     print qq("$entry" );
  938.     }
  939.     print "\n";
  940.     return '';
  941. }
  942.  
  943. sub font {
  944.     local($font) = shift;
  945.     return '\\f' . noremap($font);
  946. }
  947.  
  948. sub noremap {
  949.     local($thing_to_hide) = shift;
  950.     $thing_to_hide =~ tr/\000-\177/\200-\377/;
  951.     return $thing_to_hide;
  952. }
  953.  
  954. sub init_noremap {
  955.     if ( /[\200-\377]/ ) {
  956.     warn "$0: high bit char in input stream in paragraph $. of $ARGV\n";
  957.     }
  958. }
  959.  
  960. sub clear_noremap {
  961.     my $ready_to_print = $_[0];
  962.  
  963.     tr/\200-\377/\000-\177/;
  964.  
  965.     # trofficate backslashes
  966.     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
  967.  
  968.     # now for the E<>s, which have been hidden until now
  969.     # otherwise the interative \w<> processing would have
  970.     # been hosed by the E<gt>
  971.     s {
  972.         E<    
  973.         ( [A-Za-z]+ )    
  974.         >    
  975.     } {
  976.      do {    
  977.          exists $HTML_Escapes{$1}
  978.         ? do { $HTML_Escapes{$1} }
  979.         : do {
  980.             warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
  981.             "E<$1>";
  982.         }
  983.      }
  984.     }egx if $ready_to_print;
  985. }
  986.  
  987. sub internal_lrefs {
  988.     local($_) = shift;
  989.  
  990.     s{L</([^>]+)>}{$1}g;
  991.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  992.     my $retstr = "the ";
  993.     my $i;
  994.     for ($i = 0; $i <= $#items; $i++) {
  995.     $retstr .= "C<$items[$i]>";
  996.     $retstr .= ", " if @items > 2 && $i != $#items;
  997.     $retstr .= " and " if $i+2 == @items;
  998.     }
  999.  
  1000.     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  1001.         .  " elsewhere in this document";
  1002.  
  1003.     return $retstr;
  1004.  
  1005. }
  1006.  
  1007. BEGIN {
  1008. %HTML_Escapes = (
  1009.     'amp'    =>    '&',    #   ampersand
  1010.     'lt'    =>    '<',    #   left chevron, less-than
  1011.     'gt'    =>    '>',    #   right chevron, greater-than
  1012.     'quot'    =>    '"',    #   double quote
  1013.  
  1014.     "Aacute"    =>    "A\\*'",    #   capital A, acute accent
  1015.     "aacute"    =>    "a\\*'",    #   small a, acute accent
  1016.     "Acirc"    =>    "A\\*^",    #   capital A, circumflex accent
  1017.     "acirc"    =>    "a\\*^",    #   small a, circumflex accent
  1018.     "AElig"    =>    '\*(AE',    #   capital AE diphthong (ligature)
  1019.     "aelig"    =>    '\*(ae',    #   small ae diphthong (ligature)
  1020.     "Agrave"    =>    "A\\*`",    #   capital A, grave accent
  1021.     "agrave"    =>    "A\\*`",    #   small a, grave accent
  1022.     "Aring"    =>    'A\\*o',    #   capital A, ring
  1023.     "aring"    =>    'a\\*o',    #   small a, ring
  1024.     "Atilde"    =>    'A\\*~',    #   capital A, tilde
  1025.     "atilde"    =>    'a\\*~',    #   small a, tilde
  1026.     "Auml"    =>    'A\\*:',    #   capital A, dieresis or umlaut mark
  1027.     "auml"    =>    'a\\*:',    #   small a, dieresis or umlaut mark
  1028.     "Ccedil"    =>    'C\\*,',    #   capital C, cedilla
  1029.     "ccedil"    =>    'c\\*,',    #   small c, cedilla
  1030.     "Eacute"    =>    "E\\*'",    #   capital E, acute accent
  1031.     "eacute"    =>    "e\\*'",    #   small e, acute accent
  1032.     "Ecirc"    =>    "E\\*^",    #   capital E, circumflex accent
  1033.     "ecirc"    =>    "e\\*^",    #   small e, circumflex accent
  1034.     "Egrave"    =>    "E\\*`",    #   capital E, grave accent
  1035.     "egrave"    =>    "e\\*`",    #   small e, grave accent
  1036.     "ETH"    =>    '\\*(D-',    #   capital Eth, Icelandic
  1037.     "eth"    =>    '\\*(d-',    #   small eth, Icelandic
  1038.     "Euml"    =>    "E\\*:",    #   capital E, dieresis or umlaut mark
  1039.     "euml"    =>    "e\\*:",    #   small e, dieresis or umlaut mark
  1040.     "Iacute"    =>    "I\\*'",    #   capital I, acute accent
  1041.     "iacute"    =>    "i\\*'",    #   small i, acute accent
  1042.     "Icirc"    =>    "I\\*^",    #   capital I, circumflex accent
  1043.     "icirc"    =>    "i\\*^",    #   small i, circumflex accent
  1044.     "Igrave"    =>    "I\\*`",    #   capital I, grave accent
  1045.     "igrave"    =>    "i\\*`",    #   small i, grave accent
  1046.     "Iuml"    =>    "I\\*:",    #   capital I, dieresis or umlaut mark
  1047.     "iuml"    =>    "i\\*:",    #   small i, dieresis or umlaut mark
  1048.     "Ntilde"    =>    'N\*~',        #   capital N, tilde
  1049.     "ntilde"    =>    'n\*~',        #   small n, tilde
  1050.     "Oacute"    =>    "O\\*'",    #   capital O, acute accent
  1051.     "oacute"    =>    "o\\*'",    #   small o, acute accent
  1052.     "Ocirc"    =>    "O\\*^",    #   capital O, circumflex accent
  1053.     "ocirc"    =>    "o\\*^",    #   small o, circumflex accent
  1054.     "Ograve"    =>    "O\\*`",    #   capital O, grave accent
  1055.     "ograve"    =>    "o\\*`",    #   small o, grave accent
  1056.     "Oslash"    =>    "O\\*/",    #   capital O, slash
  1057.     "oslash"    =>    "o\\*/",    #   small o, slash
  1058.     "Otilde"    =>    "O\\*~",    #   capital O, tilde
  1059.     "otilde"    =>    "o\\*~",    #   small o, tilde
  1060.     "Ouml"    =>    "O\\*:",    #   capital O, dieresis or umlaut mark
  1061.     "ouml"    =>    "o\\*:",    #   small o, dieresis or umlaut mark
  1062.     "szlig"    =>    '\*8',        #   small sharp s, German (sz ligature)
  1063.     "THORN"    =>    '\\*(Th',    #   capital THORN, Icelandic
  1064.     "thorn"    =>    '\\*(th',,    #   small thorn, Icelandic
  1065.     "Uacute"    =>    "U\\*'",    #   capital U, acute accent
  1066.     "uacute"    =>    "u\\*'",    #   small u, acute accent
  1067.     "Ucirc"    =>    "U\\*^",    #   capital U, circumflex accent
  1068.     "ucirc"    =>    "u\\*^",    #   small u, circumflex accent
  1069.     "Ugrave"    =>    "U\\*`",    #   capital U, grave accent
  1070.     "ugrave"    =>    "u\\*`",    #   small u, grave accent
  1071.     "Uuml"    =>    "U\\*:",    #   capital U, dieresis or umlaut mark
  1072.     "uuml"    =>    "u\\*:",    #   small u, dieresis or umlaut mark
  1073.     "Yacute"    =>    "Y\\*'",    #   capital Y, acute accent
  1074.     "yacute"    =>    "y\\*'",    #   small y, acute accent
  1075.     "yuml"    =>    "y\\*:",    #   small y, dieresis or umlaut mark
  1076. );
  1077. }
  1078.  
  1079. !NO!SUBS!
  1080.  
  1081. close OUT or die "Can't close $file: $!";
  1082. chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
  1083. exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
  1084.